home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-1 / Inter.Net 55-1.iso / CBuilder / Setup / BCB / data.z / classes.int < prev    next >
Encoding:
Text File  |  1998-02-09  |  32.0 KB  |  903 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,98 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Classes;
  11.  
  12. {$R-}
  13.  
  14. { DCC32 emits inlines that take class arguments by value which results }
  15. { in a warning from the C++ compiler. Undesirable as it may be, we have}
  16. { to turn off this warning at a global level instead of just in this   }
  17. { file since HPPEMIT only emit at the top of files.                    }
  18. {$HPPEMIT '#pragma option -w-inl    '}
  19.  
  20. { ACTIVEX.HPP is not required by CLASSES.HPP }
  21. (*$NOINCLUDE ActiveX*)
  22.  
  23.  
  24. interface
  25.  
  26. uses SysUtils, Windows, ActiveX;
  27.  
  28. const
  29.  
  30. { Maximum TList size }
  31.  
  32.   MaxListSize = Maxint div 16;
  33.  
  34. { TStream seek origins }
  35.  
  36.   soFromBeginning = 0;
  37.   soFromCurrent = 1;
  38.   soFromEnd = 2;
  39.  
  40. { TFileStream create mode }
  41.  
  42.   fmCreate = $FFFF;
  43.  
  44. { TParser special tokens }
  45.  
  46.   toEOF     = Char(0);
  47.   toSymbol  = Char(1);
  48.   toString  = Char(2);
  49.   toInteger = Char(3);
  50.   toFloat   = Char(4);
  51.  
  52. type
  53.  
  54. { Text alignment types }
  55.  
  56.   TAlignment = (taLeftJustify, taRightJustify, taCenter);
  57.   TLeftRight = taLeftJustify..taRightJustify;
  58.  
  59. { Types used by standard events }
  60.  
  61.   TShiftState = set of (ssShift, ssAlt, ssCtrl,
  62.     ssLeft, ssRight, ssMiddle, ssDouble);
  63.  
  64.   THelpContext = -MaxLongint..MaxLongint;
  65.  
  66. { Standard events }
  67.  
  68.   TNotifyEvent = procedure(Sender: TObject) of object;
  69.   THelpEvent = function (Command: Word; Data: Longint;
  70.     var CallHelp: Boolean): Boolean of object;
  71.   TGetStrProc = procedure(const S: string) of object;
  72.  
  73. { Exception classes }
  74.  
  75.   EStreamError = class(Exception);
  76.   EFCreateError = class(EStreamError);
  77.   EFOpenError = class(EStreamError);
  78.   EFilerError = class(EStreamError);
  79.   EReadError = class(EFilerError);
  80.   EWriteError = class(EFilerError);
  81.   EClassNotFound = class(EFilerError);
  82.   EMethodNotFound = class(EFilerError);
  83.   EInvalidImage = class(EFilerError);
  84.   EResNotFound = class(Exception);
  85.   EListError = class(Exception);
  86.   EBitsError = class(Exception);
  87.   EStringListError = class(Exception);
  88.   EComponentError = class(Exception);
  89.   EParserError = class(Exception);
  90.   EOutOfResources = class(EOutOfMemory);
  91.   EInvalidOperation = class(Exception);
  92.  
  93. { Forward class declarations }
  94.  
  95.   TStream = class;
  96.   TFiler = class;
  97.   TReader = class;
  98.   TWriter = class;
  99.   TComponent = class;
  100.  
  101. { TList class }
  102.  
  103.   PPointerList = ^TPointerList;
  104.   TPointerList = array[0..MaxListSize - 1] of Pointer;
  105.   TListSortCompare = function (Item1, Item2: Pointer): Integer;
  106.  
  107.   TList = class(TObject)
  108.   protected
  109.     function Get(Index: Integer): Pointer;
  110.     procedure Grow; virtual;
  111.     procedure Put(Index: Integer; Item: Pointer);
  112.     procedure SetCapacity(NewCapacity: Integer);
  113.     procedure SetCount(NewCount: Integer);
  114.   public
  115.     destructor Destroy; override;
  116.     function Add(Item: Pointer): Integer;
  117.     procedure Clear; dynamic;
  118.     procedure Delete(Index: Integer);
  119.     class procedure Error(const Msg: string; Data: Integer); virtual;
  120.     procedure Exchange(Index1, Index2: Integer);
  121.     function Expand: TList;
  122.     function First: Pointer;
  123.     function IndexOf(Item: Pointer): Integer;
  124.     procedure Insert(Index: Integer; Item: Pointer);
  125.     function Last: Pointer;
  126.     procedure Move(CurIndex, NewIndex: Integer);
  127.     function Remove(Item: Pointer): Integer;
  128.     procedure Pack;
  129.     procedure Sort(Compare: TListSortCompare);
  130.     property Capacity: Integer;
  131.     property Count: Integer;
  132.     property Items[Index: Integer]: Pointer; default;
  133.     property List: PPointerList;
  134.   end;
  135.  
  136. { TThreadList class }
  137.  
  138.   TThreadList = class
  139.   public
  140.     constructor Create;
  141.     destructor Destroy; override;
  142.     procedure Add(Item: Pointer);
  143.     procedure Clear;
  144.     function  LockList: TList;
  145.     procedure Remove(Item: Pointer);
  146.     procedure UnlockList;
  147.   end;
  148.  
  149. { IInterfaceList interface }
  150.  
  151.   IInterfaceList = interface
  152.   ['{E009AAE0-F90F-11D0-8415-00A0248E4C5A}']
  153.     function Get(Index: Integer): IUnknown;
  154.     function GetCapacity: Integer;
  155.     function GetCount: Integer;
  156.     procedure Put(Index: Integer; Item: IUnknown);
  157.     procedure SetCapacity(NewCapacity: Integer);
  158.     procedure SetCount(NewCount: Integer);
  159.  
  160.     procedure Clear;
  161.     procedure Delete(Index: Integer);
  162.     function First: IUnknown;
  163.     function IndexOf(Item: IUnknown): Integer;
  164.     function Add(Item: IUnknown): Integer;
  165.     procedure Insert(Index: Integer; Item: IUnknown);
  166.     function Last: IUnknown;
  167.     function Remove(Item: IUnknown): Integer;
  168.     property Capacity: Integer;
  169.     property Count: Integer;
  170.     property Items[Index: Integer]: IUnknown; default;
  171.   end;
  172.  
  173. { EXTERNALSYM IInterfaceList}
  174.  
  175. { TInterfaceList class }
  176.  
  177.   TInterfaceList = class(TInterfacedObject, IInterfaceList)
  178.   protected
  179.     { IInterfaceList }
  180.     function Get(Index: Integer): IUnknown;
  181.     function GetCapacity: Integer;
  182.     function GetCount: Integer;
  183.     procedure Put(Index: Integer; Item: IUnknown);
  184.     procedure SetCapacity(NewCapacity: Integer);
  185.     procedure SetCount(NewCount: Integer);
  186.   public
  187.     constructor Create;
  188.     destructor Destroy; override;
  189.     procedure Clear;
  190.     procedure Delete(Index: Integer);
  191.     function Expand: TInterfaceList;
  192.     function First: IUnknown;
  193.     function IndexOf(Item: IUnknown): Integer;
  194.     function Add(Item: IUnknown): Integer;
  195.     procedure Insert(Index: Integer; Item: IUnknown);
  196.     function Last: IUnknown;
  197.     function Remove(Item: IUnknown): Integer;
  198.     property Capacity: Integer;
  199.     property Count: Integer;
  200.     property Items[Index: Integer]: IUnknown; default;
  201.   end;
  202.  
  203. { EXTERNALSYM TInterfaceList}
  204.  
  205. { TBits class }
  206.  
  207.   TBits = class
  208.   public
  209.     destructor Destroy; override;
  210.     function OpenBit: Integer;
  211.     property Bits[Index: Integer]: Boolean; default;
  212.     property Size: Integer;
  213.   end;
  214.  
  215. { TPersistent abstract class }
  216.  
  217. {$M+}
  218.  
  219.   TPersistent = class(TObject)
  220.   protected
  221.     procedure AssignTo(Dest: TPersistent); virtual;
  222.     procedure DefineProperties(Filer: TFiler); virtual;
  223.     function  GetOwner: TPersistent; dynamic;
  224.   public
  225.     destructor Destroy; override;
  226.     procedure Assign(Source: TPersistent); virtual;
  227.     function  GetNamePath: string; dynamic;
  228.   end;
  229.  
  230. {$M-}
  231.  
  232. { TPersistent class reference type }
  233.  
  234.   TPersistentClass = class of TPersistent;
  235.  
  236. { TCollection class }
  237.  
  238.   TCollection = class;
  239.  
  240.   TCollectionItem = class(TPersistent)
  241.   protected
  242.     procedure Changed(AllItems: Boolean);
  243.     function GetNamePath: string; override;
  244.     function GetOwner: TPersistent; override;
  245.     function GetDisplayName: string; virtual;
  246.     procedure SetIndex(Value: Integer); virtual;
  247.     procedure SetDisplayName(const Value: string); virtual;
  248.   public
  249.     constructor Create(Collection: TCollection); virtual;
  250.     destructor Destroy; override;
  251.     property Collection: TCollection;
  252.     property ID: Integer;
  253.     property Index: Integer;
  254.     property DisplayName: string;
  255.   end;
  256.  
  257.   TCollectionItemClass = class of TCollectionItem;
  258.  
  259.   TCollection = class(TPersistent)
  260.   protected
  261.     { Design-time editor support }
  262.     function GetAttrCount: Integer; dynamic;
  263.     function GetAttr(Index: Integer): string; dynamic;
  264.     function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
  265.     function GetNamePath: string; override;
  266.     procedure Changed;
  267.     function GetItem(Index: Integer): TCollectionItem;
  268.     procedure SetItem(Index: Integer; Value: TCollectionItem);
  269.     procedure SetItemName(Item: TCollectionItem); virtual;
  270.     procedure Update(Item: TCollectionItem); virtual;
  271.     property PropName: string;
  272.   public
  273.     constructor Create(ItemClass: TCollectionItemClass);
  274.     destructor Destroy; override;
  275.     function Add: TCollectionItem;
  276.     procedure Assign(Source: TPersistent); override;
  277.     procedure BeginUpdate;
  278.     procedure Clear;
  279.     procedure EndUpdate;
  280.     function FindItemID(ID: Integer): TCollectionItem;
  281.     function Insert(Index: Integer): TCollectionItem;
  282.     property Count: Integer;
  283.     property ItemClass: TCollectionItemClass;
  284.     property Items[Index: Integer]: TCollectionItem;
  285.   end;
  286.  
  287. { Collection class that maintains an "Owner" in order to obtain property
  288.   path information at design-time }
  289.  
  290.   TOwnedCollection = class(TCollection)
  291.   protected
  292.     function GetOwner: TPersistent; override;
  293.   public
  294.     constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  295.   end;
  296.  
  297.   TStrings = class;
  298.  
  299. { TGetModuleProc }
  300. { Uses in the TFormDesigner class to allow component/property editors access
  301.   to project specific information }
  302.  
  303.   TGetModuleProc = procedure(const FileName, UnitName, FormName,
  304.     DesignClass: string; CoClasses: TStrings) of object;
  305.  
  306. { IStringsAdapter interface }
  307. { Maintains link between TStrings and IStrings implementations }
  308.  
  309.   IStringsAdapter = interface
  310.     ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
  311.     procedure ReferenceStrings(S: TStrings);
  312.     procedure ReleaseStrings;
  313.   end;
  314.  
  315. { TStrings class }
  316.  
  317.   TStrings = class(TPersistent)
  318.   protected
  319.     procedure DefineProperties(Filer: TFiler); override;
  320.     procedure Error(const Msg: string; Data: Integer);
  321.     function Get(Index: Integer): string; virtual; abstract;
  322.     function GetCapacity: Integer; virtual;
  323.     function GetCount: Integer; virtual; abstract;
  324.     function GetObject(Index: Integer): TObject; virtual;
  325.     function GetTextStr: string; virtual;
  326.     procedure Put(Index: Integer; const S: string); virtual;
  327.     procedure PutObject(Index: Integer; AObject: TObject); virtual;
  328.     procedure SetCapacity(NewCapacity: Integer); virtual;
  329.     procedure SetTextStr(const Value: string); virtual;
  330.     procedure SetUpdateState(Updating: Boolean); virtual;
  331.   public
  332.     destructor Destroy; override;
  333.     function Add(const S: string): Integer; virtual;
  334.     function AddObject(const S: string; AObject: TObject): Integer; virtual;
  335.     procedure Append(const S: string);
  336.     procedure AddStrings(Strings: TStrings); virtual;
  337.     procedure Assign(Source: TPersistent); override;
  338.     procedure BeginUpdate;
  339.     procedure Clear; virtual; abstract;
  340.     procedure Delete(Index: Integer); virtual; abstract;
  341.     procedure EndUpdate;
  342.     function Equals(Strings: TStrings): Boolean;
  343.     procedure Exchange(Index1, Index2: Integer); virtual;
  344.     function GetText: PChar; virtual;
  345.     function IndexOf(const S: string): Integer; virtual;
  346.     function IndexOfName(const Name: string): Integer;
  347.     function IndexOfObject(AObject: TObject): Integer;
  348.     procedure Insert(Index: Integer; const S: string); virtual; abstract;
  349.     procedure InsertObject(Index: Integer; const S: string;
  350.       AObject: TObject);
  351.     procedure LoadFromFile(const FileName: string); virtual;
  352.     procedure LoadFromStream(Stream: TStream); virtual;
  353.     procedure Move(CurIndex, NewIndex: Integer); virtual;
  354.     procedure SaveToFile(const FileName: string); virtual;
  355.     procedure SaveToStream(Stream: TStream); virtual;
  356.     procedure SetText(Text: PChar); virtual;
  357.     property Capacity: Integer;
  358.     property CommaText: string;
  359.     property Count: Integer;
  360.     property Names[Index: Integer]: string;
  361.     property Objects[Index: Integer]: TObject;
  362.     property Values[const Name: string]: string;
  363.     property Strings[Index: Integer]: string; default;
  364.     property Text: string;
  365.     property StringsAdapter: IStringsAdapter;
  366.   end;
  367.  
  368. { TStringList class }
  369.  
  370.   TDuplicates = (dupIgnore, dupAccept, dupError);
  371.  
  372.   PStringItem = ^TStringItem;
  373.   TStringItem = record
  374.     FString: string;
  375.     FObject: TObject;
  376.   end;
  377.  
  378.   PStringItemList = ^TStringItemList;
  379.   TStringItemList = array[0..MaxListSize] of TStringItem;
  380.  
  381.   TStringList = class(TStrings)
  382.   protected
  383.     procedure Changed; virtual;
  384.     procedure Changing; virtual;
  385.     function Get(Index: Integer): string; override;
  386.     function GetCapacity: Integer; override;
  387.     function GetCount: Integer; override;
  388.     function GetObject(Index: Integer): TObject; override;
  389.     procedure Put(Index: Integer; const S: string); override;
  390.     procedure PutObject(Index: Integer; AObject: TObject); override;
  391.     procedure SetCapacity(NewCapacity: Integer); override;
  392.     procedure SetUpdateState(Updating: Boolean); override;
  393.   public
  394.     destructor Destroy; override;
  395.     function Add(const S: string): Integer; override;
  396.     procedure Clear; override;
  397.     procedure Delete(Index: Integer); override;
  398.     procedure Exchange(Index1, Index2: Integer); override;
  399.     function Find(const S: string; var Index: Integer): Boolean; virtual;
  400.     function IndexOf(const S: string): Integer; override;
  401.     procedure Insert(Index: Integer; const S: string); override;
  402.     procedure Sort; virtual;
  403.     property Duplicates: TDuplicates;
  404.     property Sorted: Boolean;
  405.     property OnChange: TNotifyEvent;
  406.     property OnChanging: TNotifyEvent;
  407.   end;
  408.  
  409. { TStream abstract class }
  410.  
  411.   TStream = class(TObject)
  412.   protected
  413.     procedure SetSize(NewSize: Longint); virtual;
  414.   public
  415.     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
  416.     function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
  417.     function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
  418.     procedure ReadBuffer(var Buffer; Count: Longint);
  419.     procedure WriteBuffer(const Buffer; Count: Longint);
  420.     function CopyFrom(Source: TStream; Count: Longint): Longint;
  421.     function ReadComponent(Instance: TComponent): TComponent;
  422.     function ReadComponentRes(Instance: TComponent): TComponent;
  423.     procedure WriteComponent(Instance: TComponent);
  424.     procedure WriteComponentRes(const ResName: string; Instance: TComponent);
  425.     procedure WriteDescendent(Instance, Ancestor: TComponent);
  426.     procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
  427.     procedure ReadResHeader;
  428.     property Position: Longint;
  429.     property Size: Longint;
  430.   end;
  431.  
  432. { THandleStream class }
  433.  
  434.   THandleStream = class(TStream)
  435.   protected
  436.     procedure SetSize(NewSize: Longint); override;
  437.   public
  438.     constructor Create(AHandle: Integer);
  439.     function Read(var Buffer; Count: Longint): Longint; override;
  440.     function Write(const Buffer; Count: Longint): Longint; override;
  441.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  442.     property Handle: Integer;
  443.   end;
  444.  
  445. { TFileStream class }
  446.  
  447.   TFileStream = class(THandleStream)
  448.   public
  449.     constructor Create(const FileName: string; Mode: Word);
  450.     destructor Destroy; override;
  451.   end;
  452.  
  453. { TCustomMemoryStream abstract class }
  454.  
  455.   TCustomMemoryStream = class(TStream)
  456.   protected
  457.     procedure SetPointer(Ptr: Pointer; Size: Longint);
  458.   public
  459.     function Read(var Buffer; Count: Longint): Longint; override;
  460.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  461.     procedure SaveToStream(Stream: TStream);
  462.     procedure SaveToFile(const FileName: string);
  463.     property Memory: Pointer;
  464.   end;
  465.  
  466. { TMemoryStream }
  467.  
  468.   TMemoryStream = class(TCustomMemoryStream)
  469.   protected
  470.     function Realloc(var NewCapacity: Longint): Pointer; virtual;
  471.     property Capacity: Longint;
  472.   public
  473.     destructor Destroy; override;
  474.     procedure Clear;
  475.     procedure LoadFromStream(Stream: TStream);
  476.     procedure LoadFromFile(const FileName: string);
  477.     procedure SetSize(NewSize: Longint); override;
  478.     function Write(const Buffer; Count: Longint): Longint; override;
  479.   end;
  480.  
  481. { TStringStream }
  482.  
  483.   TStringStream = class(TStream)
  484.   protected
  485.     procedure SetSize(NewSize: Longint); override;
  486.   public
  487.     constructor Create(const AString: string);
  488.     function Read(var Buffer; Count: Longint): Longint; override;
  489.     function ReadString(Count: Longint): string;
  490.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  491.     function Write(const Buffer; Count: Longint): Longint; override;
  492.     procedure WriteString(const AString: string);
  493.     property DataString: string;
  494.   end;
  495.  
  496. { TResourceStream }
  497.  
  498.   TResourceStream = class(TCustomMemoryStream)
  499.   public
  500.     constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
  501.     constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
  502.     destructor Destroy; override;
  503.     function Write(const Buffer; Count: Longint): Longint; override;
  504.   end;
  505.  
  506. { TStreamAdapter }
  507. { Implements OLE IStream on VCL TStream }
  508.  
  509.   TStreamAdapter = class(TInterfacedObject, IStream)
  510.   public
  511.     constructor Create(Stream: TStream);
  512.     function Read(pv: Pointer; cb: Longint;
  513.       pcbRead: PLongint): HResult; stdcall;
  514.     function Write(pv: Pointer; cb: Longint;
  515.       pcbWritten: PLongint): HResult; stdcall;
  516.     function Seek(dlibMove: Largeint; dwOrigin: Longint;
  517.       out libNewPosition: Largeint): HResult; stdcall;
  518.     function SetSize(libNewSize: Largeint): HResult; stdcall;
  519.     function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
  520.       out cbWritten: Largeint): HResult; stdcall;
  521.     function Commit(grfCommitFlags: Longint): HResult; stdcall;
  522.     function Revert: HResult; stdcall;
  523.     function LockRegion(libOffset: Largeint; cb: Largeint;
  524.       dwLockType: Longint): HResult; stdcall;
  525.     function UnlockRegion(libOffset: Largeint; cb: Largeint;
  526.       dwLockType: Longint): HResult; stdcall;
  527.     function Stat(out statstg: TStatStg;
  528.       grfStatFlag: Longint): HResult; stdcall;
  529.     function Clone(out stm: IStream): HResult; stdcall;
  530.   end;
  531.  
  532. { TFiler }
  533.  
  534.   TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
  535.     vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
  536.     vaNil, vaCollection);
  537.  
  538.   TFilerFlag = (ffInherited, ffChildPos);
  539.   TFilerFlags = set of TFilerFlag;
  540.  
  541.   TReaderProc = procedure(Reader: TReader) of object;
  542.   TWriterProc = procedure(Writer: TWriter) of object;
  543.   TStreamProc = procedure(Stream: TStream) of object;
  544.  
  545.   TFiler = class(TObject)
  546.   public
  547.     constructor Create(Stream: TStream; BufSize: Integer);
  548.     destructor Destroy; override;
  549.     procedure DefineProperty(const Name: string;
  550.       ReadData: TReaderProc; WriteData: TWriterProc;
  551.       HasData: Boolean); virtual; abstract;
  552.     procedure DefineBinaryProperty(const Name: string;
  553.       ReadData, WriteData: TStreamProc;
  554.       HasData: Boolean); virtual; abstract;
  555.     procedure FlushBuffer; virtual; abstract;
  556.     property Root: TComponent;
  557.     property Ancestor: TPersistent;
  558.     property IgnoreChildren: Boolean;
  559.   end;
  560.  
  561. { TReader }
  562.  
  563.   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
  564.     var Address: Pointer; var Error: Boolean) of object;
  565.   TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
  566.     var Name: string) of object;
  567.   TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
  568.   TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
  569.     ComponentClass: TPersistentClass; var Component: TComponent) of object;
  570.   TReadComponentsProc = procedure(Component: TComponent) of object;
  571.   TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
  572.  
  573.   TReader = class(TFiler)
  574.   protected
  575.     function Error(const Message: string): Boolean; virtual;
  576.     function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
  577.     procedure SetName(Component: TComponent; var Name: string); virtual;
  578.     procedure ReferenceName(var Name: string); virtual;
  579.     function FindAncestorComponent(const Name: string;
  580.       ComponentClass: TPersistentClass): TComponent; virtual;
  581.   public
  582.     destructor Destroy; override;
  583.     procedure BeginReferences;
  584.     procedure DefineProperty(const Name: string;
  585.       ReadData: TReaderProc; WriteData: TWriterProc;
  586.       HasData: Boolean); override;
  587.     procedure DefineBinaryProperty(const Name: string;
  588.       ReadData, WriteData: TStreamProc;
  589.       HasData: Boolean); override;
  590.     function EndOfList: Boolean;
  591.     procedure EndReferences;
  592.     procedure FixupReferences;
  593.     procedure FlushBuffer; override;
  594.     function NextValue: TValueType;
  595.     procedure Read(var Buf; Count: Longint);
  596.     function ReadBoolean: Boolean;
  597.     function ReadChar: Char;
  598.     procedure ReadCollection(Collection: TCollection);
  599.     function ReadComponent(Component: TComponent): TComponent;
  600.     procedure ReadComponents(AOwner, AParent: TComponent;
  601.       Proc: TReadComponentsProc);
  602.     function ReadFloat: Extended;
  603.     function ReadIdent: string;
  604.     function ReadInteger: Longint;
  605.     procedure ReadListBegin;
  606.     procedure ReadListEnd;
  607.     procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
  608.     function ReadRootComponent(Root: TComponent): TComponent;
  609.     procedure ReadSignature;
  610.     function ReadStr: string;
  611.     function ReadString: string;
  612.     function ReadValue: TValueType;
  613.     procedure CopyValue(Writer: TWriter); {!!!}
  614.     property Owner: TComponent;
  615.     property Parent: TComponent;
  616.     property Position: Longint;
  617.     property OnError: TReaderError;
  618.     property OnFindMethod: TFindMethodEvent;
  619.     property OnSetName: TSetNameEvent;
  620.     property OnReferenceName: TReferenceNameEvent;
  621.     property OnAncestorNotFound: TAncestorNotFoundEvent;
  622.   end;
  623.  
  624. { TWriter }
  625.  
  626.   TWriter = class(TFiler)
  627.   protected
  628.     procedure WriteBinary(WriteData: TStreamProc);
  629.     procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
  630.     procedure WriteValue(Value: TValueType);
  631.   public
  632.     destructor Destroy; override;
  633.     procedure DefineProperty(const Name: string;
  634.       ReadData: TReaderProc; WriteData: TWriterProc;
  635.       HasData: Boolean); override;
  636.     procedure DefineBinaryProperty(const Name: string;
  637.       ReadData, WriteData: TStreamProc;
  638.       HasData: Boolean); override;
  639.     procedure FlushBuffer; override;
  640.     procedure Write(const Buf; Count: Longint);
  641.     procedure WriteBoolean(Value: Boolean);
  642.     procedure WriteCollection(Value: TCollection);
  643.     procedure WriteComponent(Component: TComponent);
  644.     procedure WriteChar(Value: Char);
  645.     procedure WriteDescendent(Root: TComponent; AAncestor: TComponent);
  646.     procedure WriteFloat(Value: Extended);
  647.     procedure WriteIdent(const Ident: string);
  648.     procedure WriteInteger(Value: Longint);
  649.     procedure WriteListBegin;
  650.     procedure WriteListEnd;
  651.     procedure WriteRootComponent(Root: TComponent);
  652.     procedure WriteSignature;
  653.     procedure WriteStr(const Value: string);
  654.     procedure WriteString(const Value: string);
  655.     property Position: Longint;
  656.     property RootAncestor: TComponent;
  657.   end;
  658.  
  659. { TParser }
  660.  
  661.   TParser = class(TObject)
  662.   public
  663.     constructor Create(Stream: TStream);
  664.     destructor Destroy; override;
  665.     procedure CheckToken(T: Char);
  666.     procedure CheckTokenSymbol(const S: string);
  667.     procedure Error(const Ident: string);
  668.     procedure ErrorFmt(const Ident: string; const Args: array of const);
  669.     procedure ErrorStr(const Message: string);
  670.     procedure HexToBinary(Stream: TStream);
  671.     function NextToken: Char;
  672.     function SourcePos: Longint;
  673.     function TokenComponentIdent: String;
  674.     function TokenFloat: Extended;
  675.     function TokenInt: Longint;
  676.     function TokenString: string;
  677.     function TokenSymbolIs(const S: string): Boolean;
  678.     property SourceLine: Integer;
  679.     property Token: Char;
  680.   end;
  681.  
  682. { TThread }
  683.  
  684.   EThread = class(Exception);
  685.  
  686.   TThreadMethod = procedure of object;
  687.   TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
  688.     tpTimeCritical);
  689.  
  690.   TThread = class
  691.   protected
  692.     procedure DoTerminate; virtual;
  693.     procedure Execute; virtual; abstract;
  694.     procedure Synchronize(Method: TThreadMethod);
  695.     property ReturnValue: Integer;
  696.     property Terminated: Boolean;
  697.   public
  698.     constructor Create(CreateSuspended: Boolean);
  699.     destructor Destroy; override;
  700.     procedure Resume;
  701.     procedure Suspend;
  702.     procedure Terminate;
  703.     function WaitFor: Integer;
  704.     property FreeOnTerminate: Boolean;
  705.     property Handle: THandle;
  706.     property Priority: TT;
  707.     property Suspended: Boolean;
  708.     property T;
  709.     property OnTerminate: TNotifyEvent;
  710.   end;
  711.  
  712. { TComponent class }
  713.  
  714.   TOperation = (opInsert, opRemove);
  715.   TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
  716.     csDesigning, csAncestor, csUpdating, csFixups);
  717.   TComponentStyle = set of (csInheritable, csCheckPropAvail);
  718.   TGetChildProc = procedure (Child: TComponent) of object;
  719.  
  720.   TComponentName = type string;
  721.  
  722.   IVCLComObject = interface
  723.     ['{E07892A0-F52F-11CF-BD2F-0020AF0E5B81}']
  724.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  725.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  726.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  727.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  728.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  729.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  730.     function SafeCallException(ExceptObject: TObject;
  731.       ExceptAddr: Pointer): HResult;
  732.     procedure FreeOnRelease;
  733.   end;
  734.  
  735.   TComponent = class(TPersistent)
  736.   protected
  737.     FComponentStyle: TComponentStyle;
  738.     procedure ChangeName(const NewName: TComponentName);
  739.     procedure DefineProperties(Filer: TFiler); override;
  740.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
  741.     function GetChildOwner: TComponent; dynamic;
  742.     function GetChildParent: TComponent; dynamic;
  743.     function GetNamePath: string; override;
  744.     function GetOwner: TPersistent; override;
  745.     procedure Loaded; virtual;
  746.     procedure Notification(AComponent: TComponent;
  747.       Operation: TOperation); virtual;
  748.     procedure ReadState(Reader: TReader); virtual;
  749.     procedure SetAncestor(Value: Boolean);
  750.     procedure SetDesigning(Value: Boolean);
  751.     procedure SetName(const NewName: TComponentName); virtual;
  752.     procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
  753.     procedure SetParentComponent(Value: TComponent); dynamic;
  754.     procedure Updating; dynamic;
  755.     procedure Updated; dynamic;
  756.     class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); virtual;
  757.     procedure ValidateRename(AComponent: TComponent;
  758.       const CurName, NewName: string); virtual;
  759.     procedure ValidateContainer(AComponent: TComponent); dynamic;
  760.     procedure ValidateInsert(AComponent: TComponent); dynamic;
  761.     procedure WriteState(Writer: TWriter); virtual;
  762.     { IUnknown }
  763.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  764.     function _AddRef: Integer; stdcall;
  765.     function _Release: Integer; stdcall;
  766.     { IDispatch }
  767.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  768.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  769.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  770.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  771.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  772.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  773.   public
  774.     constructor Create(AOwner: TComponent); virtual;
  775.     destructor Destroy; override;
  776.     procedure DestroyComponents;
  777.     procedure Destroying;
  778.     function FindComponent(const AName: string): TComponent;
  779.     procedure FreeNotification(AComponent: TComponent);
  780.     procedure FreeOnRelease;
  781.     function GetParentComponent: TComponent; dynamic;
  782.     function HasParent: Boolean; dynamic;
  783.     procedure InsertComponent(AComponent: TComponent);
  784.     procedure RemoveComponent(AComponent: TComponent);
  785.     function SafeCallException(ExceptObject: TObject;
  786.       ExceptAddr: Pointer): HResult; override;
  787.     property ComObject: IUnknown;
  788.     property Components[Index: Integer]: TComponent;
  789.     property ComponentCount: Integer;
  790.     property ComponentIndex: Integer;
  791.     property ComponentState: TComponentState;
  792.     property ComponentStyle: TComponentStyle;
  793.     property DesignInfo: Longint;
  794.     property Owner: TComponent;
  795.     property VCLComObject: Pointer;
  796.   published
  797.     property Name: TComponentName;
  798.     property Tag: Longint default 0;
  799.   end;
  800.  
  801. { TComponent class reference type }
  802.  
  803.   TComponentClass = class of TComponent;
  804.  
  805. { Component registration handlers }
  806.  
  807.   TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
  808.  
  809. var
  810.   RegisterComponentsProc: procedure(const Page: string;
  811.     ComponentClasses: array of TComponentClass) = nil;
  812.   RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = nil;
  813.   RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
  814.     AxRegType: TActiveXRegType) = nil;
  815.   CurrentGroup: Integer = -1; { Current design group }
  816.   CreateVCLComObjectProc: procedure(Component: TComponent) = nil;
  817.  
  818. { Point and rectangle constructors }
  819.  
  820. function Point(AX, AY: Integer): TPoint;
  821. function SmallPoint(AX, AY: SmallInt): TSmallPoint;
  822. function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
  823. function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  824.  
  825. { Class registration routines }
  826.  
  827. procedure RegisterClass(AClass: TPersistentClass);
  828. procedure RegisterClasses(AClasses: array of TPersistentClass);
  829. procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
  830. procedure UnRegisterClass(AClass: TPersistentClass);
  831. procedure UnRegisterClasses(AClasses: array of TPersistentClass);
  832. procedure UnRegisterModuleClasses(Module: HMODULE);
  833. function FindClass(const ClassName: string): TPersistentClass;
  834. function GetClass(const ClassName: string): TPersistentClass;
  835.  
  836. { Component registration routines }
  837.  
  838. procedure RegisterComponents(const Page: string;
  839.   ComponentClasses: array of TComponentClass);
  840. procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
  841. procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
  842.   AxRegType: TActiveXRegType);
  843.  
  844.  
  845. { Object filing routines }
  846.  
  847. type
  848.   TIdentMapEntry = record
  849.     Value: Integer;
  850.     Name: String;
  851.   end;
  852.  
  853.   TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
  854.   TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
  855.   TFindGlobalComponent = function(const Name: string): TComponent;
  856.  
  857. var
  858.   MainThreadID: THandle;
  859.   FindGlobalComponent: TFindGlobalComponent;
  860.  
  861. procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
  862.   IntToIdent: TIntToIdent);
  863. function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
  864. function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
  865.  
  866. function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
  867. function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
  868. function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
  869. function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
  870. function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
  871. procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
  872.  
  873. procedure GlobalFixupReferences;
  874. procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
  875. procedure GetFixupInstanceNames(Root: TComponent;
  876.   const ReferenceRootName: string; Names: TStrings);
  877. procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
  878.   NewRootName: string);
  879. procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
  880. procedure RemoveFixups(Instance: TPersistent);
  881.  
  882. procedure BeginGlobalLoading;
  883. procedure NotifyGlobalLoading;
  884. procedure EndGlobalLoading;
  885.  
  886. function CollectionsEqual(C1, C2: TCollection): Boolean;
  887.  
  888. { Object conversion routines }
  889.  
  890. procedure ObjectBinaryToText(Input, Output: TStream);
  891. procedure ObjectTextToBinary(Input, Output: TStream);
  892.  
  893. procedure ObjectResourceToText(Input, Output: TStream);
  894. procedure ObjectTextToResource(Input, Output: TStream);
  895.  
  896. { Utility routines }
  897.  
  898. function LineStart(Buffer, BufPos: PChar): PChar;
  899. function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar;
  900.   Strings: TStrings): Integer;
  901.  
  902. implementation
  903.